home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / JULDAY.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  584b  |  25 lines
  1. FUNCTION julday(mm,id,iyyy: integer): integer;
  2. CONST
  3.    igreg=588829;
  4. VAR
  5.    ja,jm,jy,jul: integer;
  6. BEGIN
  7.    IF  (iyyy = 0) THEN BEGIN
  8.       writeln('there is no year zero.'); readln;
  9.    END;
  10.    IF  (iyyy < 0) THEN  iyyy := iyyy+1;
  11.    IF  (mm > 2)  THEN BEGIN
  12.       jy := iyyy;
  13.       jm := mm+1
  14.    END ELSE BEGIN
  15.       jy := iyyy-1;
  16.       jm := mm+13
  17.    END;
  18.    jul := trunc(365.25*jy)+trunc(30.6001*jm)+id+1720995;
  19.    IF  (id+31*(mm+12*iyyy) >= igreg)  THEN BEGIN
  20.       ja := trunc(0.01*jy);
  21.       jul := jul+2-ja+trunc(0.25*ja)
  22.    END;
  23.    julday := jul
  24. END;
  25.